home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol029 / gprint.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  5.0 KB  |  121 lines
  1. 900  ' THIS PROGRAM CAN BE FOUND IN THE OCT.'82 ISSUE OF CREATIVE COMPUTING.
  2. 910  '
  3. 1000 ' GPRINT - Graphics Dump Program for the IBM Personal Computer
  4. 1010 ' Will Fastie -- Original version Feb 82, revised June 82
  5. 1020 '
  6. 1030 ' This priogram transfers the contents of the Color/Graphics Adapter
  7. 1040 ' memory to a GRAFTRAX-80 or GRAFTRAX-Plus equipped IBM 80 CPS or
  8. 1050 ' EPSON MX-80 printer, to an EPSON MX-100 printer, or to a new
  9. 1060 ' generation EPSON MX-80 OR 100 printer (for which GRAFTRAX-Plus is a
  10. 1070 ' standard feature).  Medium resolution images (200 x 320) are
  11. 1080 ' converted, whether in black and white or in color.  Color
  12. 1090 ' images, which can be displayed using a 4 color set, are printed
  13. 1100 ' in black and white.
  14. 1110 '
  15. 1120 ' The program assumes that the program is executed on a machine
  16. 1130 ' equipped with the Color/Graphics Adapter only.  If both
  17. 1140 ' display adapters are present, switch to the Color/Graphics
  18. 1150 ' adapter first, then run this program.
  19. 1160 '
  20. 1170 ' -- GLOBAL program declarations
  21. 1190 DIM PIN.MASKS(8)
  22. 1200 FOR PIN = 0 TO 7
  23. 1210   PIN.MASKS(PIN) = 2^(7-PIN)
  24. 1220 NEXT PIN
  25. 1230 ESC = 27
  26. 1240 CR =13
  27. 1250 '
  28. 1260 ' This section should be written to suit you particular needs.  For
  29. 1270 ' demonstration purposes, it loads a previously stored image form the
  30. 1280 ' disk into memory of the Color/Graphics Adapter.  You could
  31. 1290 ' generate the image here instead.
  32. 1300 '
  33. 1310 KEY OFF: CLS
  34. 1320 INPUT "Enter filename of image:  ",F$
  35. 1330 SCREEN 1,0                    'Medium resolution, color enabled
  36. 1340 DEF SEG = &HB800              'Base address of CG/A memory
  37. 1350 BLOAD F$, 0
  38. 1360 '
  39. 1370 ' This section converts the image in memory to a numeric array
  40. 1380 ' containing the information required for the printer
  41. 1390 '
  42. 1400 ' -- Declar an array to hold the data
  43. 1410 NR.ROWS = 200:  NR.COLS = 320
  44. 1420 ROWS.PER.PRINTED.LINE = 8
  45. 1430 NR.LINES = NR.ROWS/ROWS.PER.PRINTED.LINE
  46. 1440 DIM LINES(NR.LINES, NR.COLS)
  47. 1450 '
  48. 1460  ' -- Initialize the array to 0
  49. 1470 FOR L = 0 TO NR.LINES-1
  50. 1480   FOR COL = 0 TO NR.COLS-1
  51. 1490     LINES(L, COL) = 0
  52. 1500   NEXT COL
  53. 1510 NEXT L
  54. 1520 '
  55. 1530 ' This section reads each point form the video memory, translates
  56. 1540 ' the points to a black and white representaion, and builds
  57. 1550 ' the data for the printer.
  58. 1560 ' The ROW and COL variables are used to calculate the position in
  59. 1570 ' which the point value should be placed.  The positions 0 through 7
  60. 1580 ' represent the printer's print head pins, from top to bottom.  The
  61. 1590 ' value in each position in the array corresponds to these pin
  62. 1600 ' positions.                       1610 '
  63. 1620 FOR ROW = 0 TO NR.ROWS-1
  64. 1630   L = ROW\ROWS.PER.PRINTED.LINE
  65. 1640   FOR COL = 0 TO NR.COLS-1
  66. 1650     IF POINT(COL, ROW) = 0 THEN GOTO 1670
  67. 1660       LINES(L, COL) = LINES(L, COL) OR PIN.MASKS(ROW MOD 8)
  68. 1670   NEXT COL
  69. 1680   BEEP
  70. 1690 NEXT ROW
  71. 1700 '
  72. 1710 ' This section prints the data by line to the printer.  No assumption
  73. 1720 ' is made about the position of the paper.
  74. 1730 '
  75. 1740 GOSUB 2110
  76. 1750 FOR L = 0 TO NR.LINES-1                   'establish line spacing
  77. 1760   N = NR.COLS:  GOSUB 2170                'put printer in graphics mode
  78. 1770   FOR COL = 0 TO NR.COLS-1
  79. 1780     C = LINES(L, COL): GOSUB 2000
  80. 1790   NEXT COL
  81. 1800   C = CR: GOSUB 2000                      'advance the paper
  82. 1810 NEXT L
  83. 1820 LPRINT: LPRINT                            'space between this and next
  84. 1830 '
  85. 1840 END
  86. 1850 '
  87. 1860 ' This routine transmits the  value in C to the printer.
  88. 1870 ' A routine like this is necessary because PRINT in BASIC interprets
  89. 1880 ' some characters, and therefore connot transmit arbitrary values.
  90. 1890 '
  91. 1900 ' This program uses the Printer Port on the IBM Monochrome Display
  92. 1910 ' and Parallel Printer Adapter.  If you just have the Printer Adapter,
  93. 1920 ' you must change the port values in this routine according to this table.
  94. 1930 '
  95. 1940 '    Port Name            MD & PPA            Just PPA
  96. 1950 '    ---------            --------            --------
  97. 1960 '    DATA in/out          &H3BC               &H378
  98. 1970 '    Printer Latch        &H3BE               &H37A
  99. 1980 '    Status Register      &H3BD               &H379
  100. 1990 '
  101. 2000 OUT &H3BE, &H6
  102. 2010 IF INP(&H3BD) <> &HDF THEN 2010
  103. 2020 OUT &H3BC, C
  104. 2030 OUT &H3BE, &H3F
  105. 2040 IF INP(&H3BD) <> &HDF THEN 2040
  106. 2050 RETURN
  107. 2060 '
  108. 2070 ' Subroutine to set line spacing to 8/72 of and inch.  Subsequent
  109. 2080 ' to this command, the printer moves the paper by this amount
  110. 2090 ' whenever a Carriage Return (13) is received.
  111. 2100 '
  112. 2110 C = ESC: GOSUB 2000: C = ASC("A"): GOSUB 2000: C = 8: GOSUB 2000
  113. 2120 RETURN
  114. 2130 '
  115. 2140 ' Subroutine to command the printer to consider the next N characters
  116. 2150 ' as Bit Image Graphics data.
  117. 2160 '
  118. 2170 C = ESC: GOSUB 2000: C = ASC("K"): GOSUB 2000
  119. 2180 IF N > 255 THEN C = N-256: GOSUB 2000: C = 1: GOSUB 2000                                   ELSE C = N:     GOSUB 2000: C = 0: GOSUB 2000
  120. 2190 RETURN
  121. 6: GOSUB 2000: C = 1: GOSUB 2000